This is a small collection of mostly game example source codes. These source codes are made available to help PlayBasic programmers kick start their game programming journey.
Looking for more source code / tutorials & media, then remember to visit the PlayBasic Resource board on our forums.
I originally wrote this demo 20 years ago in #DarkBASIC so it's fitting today to bring to #PlayBasic in full glory
The code is basically the same; visually i've added alpha addition to the lines and a globe to the line head with an alpha multiply pass to fade previous pixel date away.
I did tweak the line logic also so that rather than randomly jump between directions it'll interpolate between them. Giving a more curved motion the lines..
In this edition we've added smoother motion of the fire lines with alpha addition and rendering a circle to show the head of the line as well as a pass of alpha multiply.
WordHeap - Used to keep a Dictionary of words / strings
The Example test code (bellow) loads the PlayBasic keywords file and adds all the PB commands to a heap (a static dictionary) and then does a search for each word. The idea head is that we can build a dictionary of known words and then search if they exist or not. While the test assumes we're cataloging words (in this case PlayBasic command names), it also support none alphanumeric characters too.
PlayBasic Code:
; PROJECT : PlayBasic - KeyWord - Bucket; AUTHOR : Kev PIcone - PlayBasic TUTOR - Http://PlayBasic.com; CREATED : 24/03/2022; EDITED : 25/03/2022; ---------------------------------------------------------------------// Compute the location of the PlayBasic command listing// so we have a big list of words for something to load and test
file$=GetPlayBasicKeyWordsPath$()// Load the keywords textfile to a string
All_KeyWords$=LoadFileToString(file$)// Scan this block of text looking for the section named [Commands]// and then return it
Command_KEyWords$ = GetKeywordsUnderHeading(All_KeyWords$,"[Commands]")// Test adding PlayBasic keywords to our WordHeap
Test_KeyWord_Heap(Command_KeyWords$)// print"Test Complete - Press Space To End"; refresh display and wait for a key press before endingsyncwaitkeyendFunction Test_KeyWord_Heap(KeyWords$); Dim a string array called WORDS with an initial size of 1000dim Words$(1000)
Result$ =replace$(KeyWords$,Chr$(13)+Chr$(10),",")
count =splittoarray(Result$,",",Words$())// --------------------------------------------------// Add each word to the Word Heap / Dictionary// --------------------------------------------------For lp=0to count-1
word$ =words$(lp)
WordHeap_Add(Word$)next// --------------------------------------------------// Do a search for all the added keywords// --------------------------------------------------print" Searching For #"+Str$(Count)+" Keywords"
starttime=timer()For lp=0to count-1
word$ =words$(lp)
Status=WordHeap_FIND(Word$)#printdigits$(Status,2)+">>>"+word$
Matches+=Status
next
StartTime=Timer()-StartTime
print"Found Keywords #"+Str$(Matches)print""print"Search Time #"+Str$(StartTime)+" milliseconds"print""print""EndFunctionFunction GetKeywordsUnderHeading(KeyWords$,Heading$)
cr$=Chr$(13)+chr$(10)
Tag$=Heading$+cr$
// Lookgfor the TAG plus the linefeed / end of line within the string
StartPOS=instring(keywords$,tag$)if StartPos
// If the tag is found, we step the found position to the end// of the found location plus the tag size in characters
StartPos+=Len(tag$)// search for tbhe first empty line beyond where the starting tag// was founf
EndPos =instring(KeyWords$,Cr$+cr$,StartPos)// Check if the closing tag position was indeed after the start?if EndPos>StartPOs
// use MID$() to return this block of text from the keyword string
Result$ =mid$(Keywords$,StartPos,EndPos-StartPOs)endifendifEndFunction Result$
Function LoadFileToString(file$)ifFIleexist(file$)local size=filesize(file$)local f=readnewfile(file$)
result$=readchr$(f,size)closefile f
endifEndFunction Result$
LinkDll"shell32"
zPriv_SHGetFolderPath(hWndOwner,nFolder,hToken,dwFlags,pszPath)Alias"SHGetFolderPathA"asintegerEndLinkDllFunction zPriv_Highlighter_GetSpecialFolderPath(nFolderID)// Alloc a bank of 1024 bytes for the function to return the path inlocal Size=1024local ThisBank=newbank(Size)local Ptr=GetBankPtr(thisBank)local Status=zPriv_SHGetFolderPath(0,nFolderID,0,0,ptr)if Status=0// if status is 0 then the function worked
Path$=PeekString(ptr,0); peek a null termed string else#print"error polling GetSpeicalFolderpath"endifDeletebank ThisBank
EndFunction path$
PSUB GetPlayBasicKeyWordsPath$()
KeyWordsFile$=""; constant CSIDL_LOCAL_APPDATA = $1C ;{user}\Local App Data Settings _local folder$=zPriv_Highlighter_GetSpecialFolderPath($1C)iffolderexist(folder$)// Get the Absolute location of the PlayBasic keywords file
KeyWordsFile$=Folder$+"\PlayBasic\Info\KeyWords.txt"iffileexist(KeyWordsFile$)=false
KeyWordsFile$=""endifendifEndPSUB KeyWordsFile$
Today we'll take a look a one approach for creation echo or motion blur styled effect using nothing more than some variable addition alpha blending.
PlayBasic Code:
; PROJECT : Echo or Motion Effect; AUTHOR : Kev Picone - http://PlayBasic.com; CREATED : 14/11/2021; EDITED : 14/11/2021; ---------------------------------------------------------------------// -------------------------------------------------------// ---------------------- MAIN LOOP ----------------------// -------------------------------------------------------type tobject
X#(10)
Y#(10)
SpeedX#
SpeedY#
Colour
endtypeDim Objects(35)as tobject
for lp=1togetarrayelements(Objects())
Objects(lp)=new tobject
x#=rnd(800)
y#=rnd(600)for poslp=0to10
Objects(lp).x#(poslp)= x#
Objects(lp).y#(poslp)= y#
next
Speed#=rndrange#(10,20)
Angle#=Rnd(360)
Objects(lp).speedx#=cos(Angle#)*Speed#
Objects(lp).speedy#=sin(Angle#)*Speed#
Objects(lp).Colour =rndrgb()next
Screen=Newfximage(GetScreenWidth(),GetScreenheight())// -------------------------------------------------------do// -------------------- MAIN LOOP ---------------------// -------------------------------------------------------for lp=1togetarrayelements(Objects())
x#=Objects(lp).x#(0)
y#=Objects(lp).y#(0)
x#+=Objects(lp).speedx#
y#+=Objects(lp).speedy#
// scroll old positions downfor oldpos=10to1step-1
Objects(lp).x#(oldpos)=Objects(lp).x#(oldpos-1)
Objects(lp).y#(oldpos)=Objects(lp).y#(oldpos-1)nextif x#<0then x#=0 : Objects(lp).speedx#*=-1if x#>800then x#=800 : Objects(lp).speedx#*=-1if y#<0then y#=0 : Objects(lp).speedy#*=-1if y#>600then y#=600 : Objects(lp).speedy#*=-1
Objects(lp).x#(0)=x#
Objects(lp).y#(0)=y#
nextrendertoimage Screen
cls0// render lockbuffer; set ink pen drawing mode to Alpha Addition / Alpha ADD inkmode1+64; step through the objects and the draw the oldest ones first; looping to the last down to first.for pass=10to0step-1
blendlevel#=cliprange#(pass/10.0,0,1)
BlendColour =255-(255*BlendLevel#)
BlendColour=Rgb(BlendColour,BlendColour,BlendColour)// Draw all the objects from this pass in one groupfor lp=1togetarrayelements(Objects())
x#=Objects(lp).x#(pass)
y#=Objects(lp).y#(pass)// Compute the objects colour with the fade level
ThisRGB =rgbAlphamult(Objects(lp).Colour, BlendColour)// draw it as a circlecirclec x#,y#,32,true,ThisRGB
nextnextunlockbuffer; set inkmode back to normalinkmode1rendertoscreendrawimage screen,0,0,falsesyncwait10loopspacekey()
PlayBasic LIVE - Overview of Object Echo / Motion Blur Example - (2021-11-16)
Point On Line - Line Hit Point - Point Intersect Line
Point On Line / Line Hit Point / Point Intersect
Line
This code defines a tLines data type that consists of four floating point numbers (x1#, y1#, x2#, y2#). It then creates an array of 100 elements of this data type called Lines.
It then initializes each element of the Lines array by assigning random values to its x1#, y1#, x2#, and y2# fields.
Afterwards, the code enters an infinite loop that does the following:
Clears the screen
Gets the current mouse position and assigns it to variables mx# and my#
Iterates through each element lp in the Lines array and does the following:
Assigns the x1#, y1#, x2#, and y2# fields of the current element to local variables x1#, y1#, x2#, and y2#, respectively
Calls the Point_On_Line function, passing it mx#, my#, x1#, y1#, x2#, and y2# as arguments. The return value of this function is a boolean that indicates whether the point (mx#, my#) is on the line defined by the points (x1#, y1#) and (x2#, y2#).
If the return value of Point_On_Line is True, it sets the current drawing color to a random RGB value.
It then draws a line between the points (x1#, y1#) and (x2#, y2#) using the current drawing color.
Waits for the vertical blanking interval (to prevent tearing)
Loops back to the beginning if the space key is not pressed
The code then defines the Point_On_Line function, which takes six floating point arguments: pointx#, pointy#, x1#, y1#, x2#, and y2#. It returns a boolean value indicating whether the point (pointx#, pointy#) is on the line defined by the points (x1#, y1#) and (x2#, y2#).
The function first checks if the point (pointx#, pointy#) is at least parallel to the line defined by the points (x1#, y1#) and (x2#, y2#). If it is, it calculates the nearest point on the line to (pointx#, pointy#) and checks if the distance between the two points is within a certain tolerance (1 in this case). If the distance is within the tolerance, the function returns True, otherwise it returns False. If the point (pointx#, pointy#) was not parallel to the line, the function immediately returns False.
PlayBasic Code:
; PROJECT : POint On Line; AUTHOR : PlayBasic TUTOR; CREATED : 4/10/2021; EDITED : 5/10/2021; ---------------------------------------------------------------------type tlines
x1#,y1#,x2#,y2#
endtypeDim Lines(100)as tLines
for lp =0to100
Lines(lp).x1 =rnd(800)
Lines(lp).y1 =rnd(600)
Lines(lp).x2 =rnd(800)
Lines(lp).y2 =rnd(600)nextdocls
mx#=mousex()
my#=mousey()for lp =0to100
x1#=lines(lp).x1
y1#=lines(lp).y1
x2#=lines(lp).x2
y2#=lines(lp).y2
ink-1if Point_On_line(mx#,my#,x1#,y1#,x2#,y2#)inkrndrgb()endifline x1#,y1#,x2#,y2#
nextsyncloopspacekey()endfunction Point_On_line(pointx#,pointy#,x1#,y1#,x2#,y2#)// compute nearest point along the line
dx31#=PointX#-x1#
dx21#=x2#-x1#
dy31#=PointY#-y1#
dy21#=y2#-y1#
l#=((dx31#*dx21#)+(dy31#*dy21#))/((dx21#*dx21#)+(dy21#*dy21#))// see if our point at least lies parallel with our line
status = l#>=0and L#<=1if Status
// if so, we compute the nearest point on the line
x#=x1#+(dx21#*l#)
y#=y1#+(dy21#*l#)// then get the distance from the line to our point.
Dist# =getdistance2d(x#,y#,pointx#,pointy#)// check if it's within a tolerance of 1, might need// to be tweaked
Status = Dist#<=1endifEndFunction status
PlayBasic LIVE - Revisiting Twitch Face Demo - (2020-07-14 )
Here we're taking a look back a demo called Twitch Face from way back in February of 2006. The demo is various stacked blends that 'twitch' or are offset from each other.
This function grabs a chunk from another image, then draws a circle to alpha channel to mask out the bits we want, giving up a 007 sort of circle reveal effect.
Release Type:
The source code & tutorials found on this site are released as license ware for PlayBasic Users. No Person or Company may redistribute any file (tutorial / source code or media files) from this site, without explicit written permission.